home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
EAGUI
/
EASeperators.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
7KB
|
224 lines
(*************************************************************************
$RCSfile: EASeperators.mod $
Description: 3D seperator for EAGUI.
Created by: fjc (Frank Copeland)
$Revision: 1.2 $
$Author: fjc $
$Date: 1995/06/04 23:20:20 $
Copyright © 1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
*************************************************************************)
<* STANDARD- *>
<*$ StackChk- *>
<*$ LongVars+ *>
MODULE EASeperators;
IMPORT
SYS := SYSTEM, Kernel, s := Sets, e := Exec, u := Utility,
gfx := Graphics, i := Intuition, ea := EAGUI;
CONST
(* Rendering flags. *)
Recessed* = 0; (* Draw a recessed line, otherwise draw a raised
* one.
*)
TYPE
(* Information that is needed by this object, but that isn't maintained
* by EAGUI itself.
*)
SeperatorPtr * = POINTER [2] TO Seperator;
Seperator * = RECORD [2]
flags * : s.SET32; (* different flags *)
shinePen *,
shadowPen * : e.UBYTE; (* pens to use *)
END;
VAR
MinSizeHook *, RenderHook * : u.HookPtr;
hook1, hook2 : u.Hook;
(*************************************************************************
* *
* MinSize Method *
* *
*************************************************************************)
PROCEDURE MinSize*
( hook : u.HookPtr;
obj : ea.OPTR;
msg : e.APTR )
: e.ULONG;
VAR
minwidth, minheight, type, ignore : LONGINT;
sep : SeperatorPtr;
group : ea.OPTR;
BEGIN (* MinSize *)
(* get a pointer to our structure, and check if we actually got it *)
sep := SYS.VAL (SeperatorPtr, ea.GetAttr (obj, ea.UserData));
IF sep # NIL THEN
(* get the container object *)
group := SYS.VAL (ea.OPTR, ea.GetAttr (obj, ea.Parent));
ASSERT (group # NIL, 96);
(* get group type *)
type := ea.GetAttr (group, ea.Type);
ASSERT (type IN {ea.TYPE_VGROUP, ea.TYPE_HGROUP}, 96);
IF type = ea.TYPE_VGROUP THEN
minwidth := 0; minheight := 2
ELSE
minwidth := 2; minheight := 0
END;
(* and finally, we set these values *)
ignore := ea.SetAttr (obj, ea.MinWidth, minwidth);
ignore := ea.SetAttr (obj, ea.MinHeight, minheight);
END;
(* we always return success *)
RETURN 0
END MinSize;
(*************************************************************************
* *
* Render Method *
* *
*************************************************************************)
PROCEDURE Render*
( hook : u.HookPtr;
obj : ea.OPTR;
rm : ea.RenderMessagePtr )
: e.ULONG;
VAR
sep : SeperatorPtr;
width, height, left, top, type, ignore : e.ULONG;
x1, y1, x2, y2, dx, dy : e.UWORD;
pen1, pen2 : e.UBYTE;
group : ea.OPTR;
recessed : BOOLEAN;
BEGIN (* Render *)
(* get a pointer to our structure, and check if we actually got it *)
sep := SYS.VAL (SeperatorPtr, ea.GetAttr (obj, ea.UserData));
IF sep # NIL THEN
(* get the container object *)
group := SYS.VAL (ea.OPTR, ea.GetAttr (obj, ea.Parent));
ASSERT (group # NIL, 96);
(* get group type *)
type := ea.GetAttr (group, ea.Type);
ASSERT (type IN {ea.TYPE_VGROUP, ea.TYPE_HGROUP}, 96);
(* get sizes of the object *)
ignore := ea.GetAttrs ( obj,
ea.Width, SYS.ADR (width),
ea.Height, SYS.ADR (height),
u.done );
(* get offsets of object relative to root (window) *)
left := ea.GetObjectLeft (rm.root_ptr, obj);
top := ea.GetObjectTop (rm.root_ptr, obj);
IF Recessed IN sep.flags THEN
pen1 := sep.shadowPen; pen2 := sep.shinePen
ELSE
pen2 := sep.shadowPen; pen1 := sep.shinePen
END;
x1 := SHORT (left); y1 := SHORT (top);
IF type = ea.TYPE_VGROUP THEN
x2 := x1 + SHORT (width) - 1; y2 := y1;
dx := 0; dy := 1
ELSE
x2 := x1; y2 := y1 + SHORT (height) - 1;
dx := 1; dy := 0
END;
gfx.Move (rm.rastport_ptr, x1, y1);
gfx.SetAPen (rm.rastport_ptr, pen1);
gfx.Draw (rm.rastport_ptr, x2, y2);
gfx.Move (rm.rastport_ptr, x1 + dx, y1 + dy);
gfx.SetAPen (rm.rastport_ptr, pen2);
gfx.Draw (rm.rastport_ptr, x2 + dx, y2 + dy)
END;
(* return success *)
RETURN 0
END Render;
(*************************************************************************
* *
* Constructors *
* *
*************************************************************************)
PROCEDURE xNewSeperator () : ea.OPTR;
<*$ ReturnChk- *>
BEGIN (* xNewSeperator *)
SYS.SETREG (0,
ea.NewObject ( ea.TYPE_CUSTOMIMAGE,
ea.MinSizeMethod, MinSizeHook,
ea.RenderMethod, RenderHook,
ea.UserData, SYS.REG (8), (* sep *)
u.more, SYS.REG (9), (* tags *)
u.done ))
END xNewSeperator;
PROCEDURE [4] NewSeperator* ["EASeperators_xNewSeperator"]
( VAR sep [8] : Seperator;
tags [9].. : u.Tag )
: ea.OPTR;
PROCEDURE [4] NewSeperatorA* ["EASeperators_xNewSeperator"]
( VAR sep [8] : Seperator;
tags [9] : u.TagListPtr )
: ea.OPTR;
PROCEDURE InitSeperator*
( VAR sep : Seperator;
flags : s.SET32;
drawInfo : i.DrawInfoPtr );
BEGIN (* InitSeperator *)
sep.flags := flags;
IF drawInfo # NIL THEN
sep.shinePen := SHORT (drawInfo.pens [i.shinePen]);
sep.shadowPen := SHORT (drawInfo.pens [i.shadowPen]);
ELSE
sep.shinePen := 2; sep.shadowPen := 1
END;
END InitSeperator;
(************************************************************************)
<*$ LongVars- *>
PROCEDURE Init;
BEGIN (* Init *)
MinSizeHook := SYS.ADR (hook1); RenderHook := SYS.ADR (hook2);
u.InitHook (MinSizeHook, SYS.VAL (u.HookFunc, MinSize));
u.InitHook (RenderHook, SYS.VAL (u.HookFunc, Render));
END Init;
BEGIN
Init
END EASeperators.